unit uCmdLink;

interface

uses Windows, Classes, Controls, Graphics;

type
  TXButtonState = (xbsUp, xbsDisabled, xbsDown, xbsExclusive);

  TCommandLink = class(TGraphicControl)
  private
    FDown: boolean;
    FMouseInControl: boolean;
    FDragging: boolean;
    procedure UpdateTracking;
  protected
    FState: TXButtonState;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure Paint; override;
  end;

implementation

var
  vBrushIdle,
  vBrushHover: TBrush;

{ TCommandLink }

procedure TCommandLink.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseDown(Button, Shift, X, Y);
  if (Button = mbLeft) and Enabled then begin
    if not FDown then begin
      FState := xbsDown;
      Invalidate;
    end;
    FDragging := True;
  end;
end;

procedure TCommandLink.MouseMove(Shift: TShiftState; X, Y: Integer);
var NewState: TXButtonState;
begin
  inherited MouseMove(Shift, X, Y);
  UpdateTracking;
end;

procedure TCommandLink.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var DoClick: Boolean;
begin
  inherited MouseUp(Button, Shift, X, Y);
  if FDragging then begin
    FDragging := False;
    DoClick := (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <= ClientHeight);

    { Redraw face in-case mouse is captured }
    FState := xbsUp;
    FMouseInControl := False;
    if DoClick and not (FState in [xbsExclusive, xbsDown]) then Invalidate;
    if DoClick then Click;
    UpdateTracking;
  end;
end;

procedure TCommandLink.Paint;
var PaintRect: TRect;
    obr,opn: HGDIOBJ;
begin
  inherited;
  PaintRect := ClientRect;

  if (FMouseInControl) then
    obr := SelectObject(canvas.Handle, vBrushHover.Handle)
  else
    obr := SelectObject(canvas.Handle, vBrushIdle.Handle);

  RoundRect(Canvas.Handle,
    PaintRect.Left, PaintRect.Top,
    PaintRect.Right, PaintRect.Bottom,
    5, 5);
  SelectObject(Canvas.Handle, obr);
end;

procedure TCommandLink.UpdateTracking;
var p: TPoint;
    tmp: boolean;
begin
  if Enabled then begin
    GetCursorPos(P);
    tmp := not (FindDragTarget(P, True) = Self);
    if (tmp<>FMouseInControl) then begin
      FMouseInControl := tmp;
      if FMouseInControl then
        Perform(CM_MOUSELEAVE, 0, 0)
      else
        Perform(CM_MOUSEENTER, 0, 0);
        
      Invalidate;
    end;
  end;
end;

initialization
  vBrushIdle := TBrush.Create;
  vBrushIdle.Color := clWindow;
  vBrushHover := TBrush.Create;
  vBrushHover.Color := clSilver;

finalization
  vBrushIdle.Free;
  vBrushHover.Free;

end.
